home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / scm / xscm.lha / xscm / x.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-08-29  |  25.6 KB  |  978 lines
  1. /*
  2.  * $Header: /home/campbell/Languages/Scheme/scm/x-scm/RCS/x.c,v 1.8 1992/08/18 00:43:02 campbell Beta $
  3.  *
  4.  * Author: Larry Campbell (campbell@redsox.bsw.com)
  5.  *
  6.  * Copyright 1992 by The Boston Software Works, Inc.
  7.  * Permission to use for any purpose whatsoever granted, as long
  8.  * as this copyright notice remains intact.  Please send bug fixes
  9.  * or enhancements to the above email address.
  10.  *
  11.  * Generic X and Xlib functions for scm.
  12.  * These functions do not depend on any toolkit.
  13.  */
  14.  
  15. #include <assert.h>
  16. #include <stdio.h>
  17. #include <X11/X.h>
  18. #include <X11/Xlib.h>
  19. #include <X11/cursorfont.h>
  20.  
  21. #include "scm.h"
  22. #include "x.h"
  23.  
  24. static char s_x_alloc_color[]        = "x:alloc-color";
  25. static char s_x_alloc_color_cells[]    = "x:alloc-color-cells";
  26. static char s_x_clear_area[]        = "x:clear-area";
  27. static char s_x_copy_area[]        = "x:copy-area";
  28. static char s_x_create_colormap[]    = "x:create-colormap";
  29. static char s_x_create_gc[]        = "x:create-gc";
  30. static char s_x_create_pixmap[]        = "x:create-pixmap";
  31. static char s_x_default_colormap[]    = "x:default-colormap";
  32. static char s_x_define_cursor[]        = "x:define-cursor";
  33. static char s_x_display_cells[]        = "x:display-cells";
  34. static char s_x_display_depth[]        = "x:display-depth";
  35. static char s_x_display_height[]    = "x:display-height";
  36. static char s_x_display_width[]        = "x:display-width";
  37. static char s_x_draw_lines[]        = "x:draw-lines";
  38. static char s_x_draw_points[]        = "x:draw-points";
  39. static char s_x_fill_rectangle[]    = "x:fill-rectangle";
  40. static char s_x_flush[]            = "x:flush";
  41. static char s_x_free_colormap[]        = "x:free-colormap";
  42. static char s_x_free_pixmap[]        = "x:free-pixmap";
  43. static char s_x_install_colormap[]    = "x:install-colormap";
  44. static char s_x_get_event_field[]    = "x:get-event-field";
  45. static char s_x_root_window[]        = "x:root-window";
  46. static char s_x_set_background[]    = "x:set-background";
  47. static char s_x_set_foreground[]    = "x:set-foreground";
  48. static char s_x_set_window_colormap[]    = "x:set-window-colormap";
  49. static char s_x_store_color[]        = "x:store-color";
  50. static char s_x_undefine_cursor[]    = "x:undefine-cursor";
  51. static char s_x_x_scm_version[]        = "x:x-scm-version";
  52.  
  53. static char s_x__make_gc_values[]    = "internal function x__make_gc_values";
  54.  
  55.  
  56. /*
  57.  * These should really be defined similarly to ARG[1-5]...
  58.  */
  59.  
  60. static char ARG6[] = "arg6";
  61. static char ARG7[] = "arg7";
  62. static char ARG8[] = "arg8";
  63. static char ARG9[] = "arg9";
  64.  
  65.  
  66. static struct {
  67.   short id;
  68.   char *name;
  69.   SCM sym;
  70. } cursor_table[] = {
  71.   {XC_X_cursor,            "xc:x-cursor",            0},
  72.   {XC_arrow,            "xc:arrow",            0},
  73.   {XC_based_arrow_down,        "xc:based-arrow-down",        0},
  74.   {XC_based_arrow_up,        "xc:based-arrow-up",        0},
  75.   {XC_boat,            "xc:boat",            0},
  76.   {XC_bogosity,            "xc:bogosity",            0},
  77.   {XC_bottom_left_corner,    "xc:bottom-left-corner",    0},
  78.   {XC_bottom_right_corner,    "xc:bottom-right-corner",    0},
  79.   {XC_bottom_side,        "xc:bottom-side",        0},
  80.   {XC_bottom_tee,        "xc:bottom-tee",        0},
  81.   {XC_box_spiral,        "xc:box-spiral",        0},
  82.   {XC_center_ptr,        "xc:center-ptr",        0},
  83.   {XC_circle,            "xc:circle",            0},
  84.   {XC_clock,            "xc:clock",            0},
  85.   {XC_coffee_mug,        "xc:coffee-mug",        0},
  86.   {XC_cross,            "xc:cross",            0},
  87.   {XC_cross_reverse,        "xc:cross-reverse",        0},
  88.   {XC_crosshair,        "xc:crosshair",            0},
  89.   {XC_diamond_cross,        "xc:diamond-cross",        0},
  90.   {XC_dot,            "xc:dot",            0},
  91.   {XC_dotbox,            "xc:dotbox",            0},
  92.   {XC_double_arrow,        "xc:double-arrow",        0},
  93.   {XC_draft_large,        "xc:draft-large",        0},
  94.   {XC_draft_small,        "xc:draft-small",        0},
  95.   {XC_draped_box,        "xc:draped-box",        0},
  96.   {XC_exchange,            "xc:exchange",            0},
  97.   {XC_fleur,            "xc:fleur",            0},
  98.   {XC_gobbler,            "xc:gobbler",            0},
  99.   {XC_gumby,            "xc:gumby",            0},
  100.   {XC_hand1,            "xc:hand1",            0},
  101.   {XC_hand2,            "xc:hand2",            0},
  102.   {XC_heart,            "xc:heart",            0},
  103.   {XC_icon,            "xc:icon",            0},
  104.   {XC_iron_cross,        "xc:iron-cross",        0},
  105.   {XC_left_ptr,            "xc:left-ptr",            0},
  106.   {XC_left_side,        "xc:left-side",            0},
  107.   {XC_left_tee,            "xc:left-tee",            0},
  108.   {XC_leftbutton,        "xc:leftbutton",        0},
  109.   {XC_ll_angle,            "xc:ll-angle",            0},
  110.   {XC_lr_angle,            "xc:lr-angle",            0},
  111.   {XC_man,            "xc:man",            0},
  112.   {XC_middlebutton,        "xc:middlebutton",        0},
  113.   {XC_mouse,            "xc:mouse",            0},
  114.   {XC_pencil,            "xc:pencil",            0},
  115.   {XC_pirate,            "xc:pirate",            0},
  116.   {XC_plus,            "xc:plus",            0},
  117.   {XC_question_arrow,        "xc:question-arrow",        0},
  118.   {XC_right_ptr,        "xc:right-ptr",            0},
  119.   {XC_right_side,        "xc:right-side",        0},
  120.   {XC_right_tee,        "xc:right-tee",            0},
  121.   {XC_rightbutton,        "xc:rightbutton",        0},
  122.   {XC_rtl_logo,            "xc:rtl-logo",            0},
  123.   {XC_sailboat,            "xc:sailboat",            0},
  124.   {XC_sb_down_arrow,        "xc:sb-down-arrow",        0},
  125.   {XC_sb_h_double_arrow,    "xc:sb-h-double-arrow",        0},
  126.   {XC_sb_left_arrow,        "xc:sb-left-arrow",        0},
  127.   {XC_sb_right_arrow,        "xc:sb-right-arrow",        0},
  128.   {XC_sb_up_arrow,        "xc:sb-up-arrow",        0},
  129.   {XC_sb_v_double_arrow,    "xc:sb-v-double-arrow",        0},
  130.   {XC_shuttle,            "xc:shuttle",            0},
  131.   {XC_sizing,            "xc:sizing",            0},
  132.   {XC_spider,            "xc:spider",            0},
  133.   {XC_spraycan,            "xc:spraycan",            0},
  134.   {XC_star,            "xc:star",            0},
  135.   {XC_target,            "xc:target",            0},
  136.   {XC_tcross,            "xc:tcross",            0},
  137.   {XC_top_left_arrow,        "xc:top-left-arrow",        0},
  138.   {XC_top_left_corner,        "xc:top-left-corner",        0},
  139.   {XC_top_right_corner,        "xc:top-right-corner",        0},
  140.   {XC_top_side,            "xc:top-side",            0},
  141.   {XC_top_tee,            "xc:top-tee",            0},
  142.   {XC_trek,            "xc:trek",            0},
  143.   {XC_ul_angle,            "xc:ul-angle",            0},
  144.   {XC_umbrella,            "xc:umbrella",            0},
  145.   {XC_ur_angle,            "xc:ur-angle",            0},
  146.   {XC_watch,            "xc:watch",            0},
  147.   {XC_xterm,            "xc:xterm",            0},
  148. };
  149.  
  150.  
  151. /*
  152.  * Scheme types defined in this module
  153.  */
  154.  
  155. #undef XX
  156. #define XX(name, mark, free)            \
  157. long TOKEN_PASTE(tc16_,name);            \
  158. static int TOKEN_PASTE(print_,name)();        \
  159. static smobfuns TOKEN_PASTE(smob,name) =    \
  160.     { mark, free, TOKEN_PASTE(print_,name) };
  161.  
  162. X_SMOBS
  163.  
  164.  
  165. /*
  166.  * GC mark function that just marks this cell and returns BOOL_F,
  167.  * as there are no further objects off this one
  168.  */
  169.  
  170. SCM mark_no_further(ptr)
  171. SCM ptr;
  172. {
  173.   assert(TYP7(ptr) == tc7_smob);
  174.   SETGC8MARK(ptr);
  175.   return BOOL_F;
  176. }
  177.  
  178.  
  179. static SCM make_xcolormap(c)
  180. Colormap c;
  181. {
  182.   SCM w;
  183.   NEWCELL(w);
  184.   DEFER_INTS;
  185.   CAR(w) = tc16_xcolormap;
  186.   SETCDR(w,c);
  187.   ALLOW_INTS;
  188.   return w;
  189. }
  190.  
  191. SCM make_xevent(e)
  192. XEvent *e;
  193. {
  194.   SCM w;
  195.   XEvent *ec;
  196.  
  197.   ec = (XEvent *) must_malloc(sizeof(XEvent), "make_xevent");
  198.   (void) memcpy(ec, e, sizeof(XEvent));
  199.   NEWCELL(w);
  200.   DEFER_INTS;
  201.   CAR(w) = tc16_xevent;
  202.   SETCDR(w,ec);
  203.   ALLOW_INTS;
  204.   return w;
  205. }
  206.  
  207. SCM make_xdisplay(d)
  208. Display *d;
  209. {
  210.   SCM w;
  211.   NEWCELL(w);
  212.   DEFER_INTS;
  213.   CAR(w) = tc16_xdisplay;
  214.   SETCDR(w,d);
  215.   ALLOW_INTS;
  216.   return w;
  217. }
  218.  
  219. SCM make_xgc(gc)
  220. GC gc;
  221. {
  222.   SCM g;
  223.   NEWCELL(g);
  224.   DEFER_INTS;
  225.   CAR(g) = tc16_xgc;
  226.   SETCDR(g,gc);
  227.   ALLOW_INTS;
  228.   return g;
  229. }
  230.  
  231. SCM make_xpixmap()
  232. {
  233.   SCM p;
  234.   NEWCELL(p);
  235.   CAR(p) = tc16_xpixmap;
  236.   CDR(p) = 0;
  237.   return p;
  238. }
  239.  
  240. SCM make_xwindow(w)
  241. Window w;
  242. {
  243.   SCM sw;
  244.   NEWCELL(sw);
  245.   DEFER_INTS;
  246.   CAR(sw) = tc16_xwindow;
  247.   SETCDR(sw,w);
  248.   ALLOW_INTS;
  249.   return sw;
  250. }
  251.  
  252. sizet x_free_xevent(ptr)
  253. SCM ptr;
  254. {
  255.   free(CHARS(ptr));
  256.   return sizeof(XEvent);
  257. }
  258.  
  259. static void x__draw();
  260. static void x__make_gc_values();
  261.  
  262. #define XDRAWABLEP(x) (XWINDOWP(x) || XPIXMAPP(x))
  263.  
  264. #define GET_NEXT_INT(result, args, err, rtn) \
  265.     ASSERT(NIMP(args) && CONSP(args) && INUMP(CAR(args)), args, err, rtn); \
  266.     result = INUM(CAR(args)); \
  267.       args = CDR(args);
  268.  
  269.  
  270. SCM x_alloc_color(s_dpy, s_cmap, s_args)
  271. SCM s_dpy, s_cmap, s_args;
  272. {
  273.   XColor xc;
  274.  
  275.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_alloc_color);
  276.   ASSERT(NIMP(s_cmap) && XCOLORMAPP(s_cmap), s_cmap, ARG2, s_x_alloc_color);
  277.   GET_NEXT_INT(xc.red, s_args, ARG3, s_x_alloc_color);
  278.   GET_NEXT_INT(xc.green, s_args, ARG4, s_x_alloc_color);
  279.   GET_NEXT_INT(xc.blue, s_args, ARG5, s_x_alloc_color);
  280.   if (XAllocColor(XDISPLAY(s_dpy), XCOLORMAP(s_cmap), &xc))
  281.     return MAKINUM(xc.pixel);
  282.   else
  283.     return BOOL_F;
  284. }
  285.  
  286.  
  287. SCM x_alloc_color_cells(s_dpy, s_cmap, s_args)
  288. SCM s_dpy, s_cmap, s_args;
  289. {
  290.   SCM s;
  291.   Bool contig;
  292.   int nplanes, ncolors, i;
  293.   unsigned long *planes, *colors;
  294.   SCM s_planes, s_colors, result;
  295.  
  296.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_alloc_color_cells);
  297.   ASSERT(NIMP(s_cmap) && XCOLORMAPP(s_cmap), s_cmap, ARG2, s_x_alloc_color_cells);
  298.   ASSERT(NIMP(s_args) && CONSP(s_args), s_args, ARG3, s_x_alloc_color_cells);
  299.   s = CAR(s_args);
  300.   s_args = CDR(s_args);
  301.   contig = !(FALSEP(s) || NULLP(s));
  302.   GET_NEXT_INT(nplanes, s_args, ARG4, s_x_alloc_color_cells);
  303.   GET_NEXT_INT(ncolors, s_args, ARG4, s_x_alloc_color_cells);
  304.   ASSERT(ncolors > 0, ncolors, "must allocate >0 colors", s_x_alloc_color_cells);
  305.   if (nplanes)
  306.     planes = (unsigned long *) must_malloc(
  307.       nplanes * sizeof(unsigned long), s_x_alloc_color_cells);
  308.   colors = (unsigned long *) must_malloc(
  309.     ncolors * sizeof(unsigned long), s_x_alloc_color_cells);
  310.  
  311.   if (!XAllocColorCells(XDISPLAY(s_dpy), XCOLORMAP(s_cmap), contig,
  312.                         planes, nplanes, colors, ncolors)) {
  313.     result = BOOL_F;
  314.   } else {
  315.     s_planes = EOL;
  316.     s_colors = EOL;
  317.     for (i = 0; i < nplanes; i++)
  318.       s_planes = cons(MAKINUM(planes[i]), s_planes);
  319.     for (i = 0; i < ncolors; i++)
  320.       s_colors = cons(MAKINUM(colors[i]), s_colors);
  321.  
  322.     result = EOL;
  323.     result = cons(s_colors, result);
  324.     result = cons(s_planes, result);
  325.   }
  326.  
  327.   free(colors);
  328.   if (nplanes) free(planes);
  329.  
  330.   return result;
  331. }
  332.  
  333.  
  334. SCM x_clear_area(s_dpy, s_win, args)
  335. SCM s_dpy, s_win, args;
  336. {
  337.   int x, y, width, height;
  338.   Bool expose_flag;
  339.  
  340.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_clear_area);
  341.   ASSERT(NIMP(s_win) && XWINDOWP(s_win), s_win, ARG2, s_x_clear_area);
  342.  
  343.   GET_NEXT_INT(x, args, ARG3, s_x_clear_area);
  344.   GET_NEXT_INT(y, args, ARG4, s_x_clear_area);
  345.   GET_NEXT_INT(width, args, ARG5, s_x_clear_area);
  346.   GET_NEXT_INT(height, args, "arg6", s_x_clear_area);
  347.  
  348.   ASSERT(NIMP(args) && CONSP(args), args, "arg7", s_x_clear_area);
  349.   expose_flag = (CAR(args) == BOOL_T);
  350.  
  351.   XClearArea(XDISPLAY(s_dpy), XWINDOW(s_win), x, y, width, height, expose_flag);
  352.  
  353.   return UNSPECIFIED;
  354. }
  355.  
  356. SCM x_copy_area(s_dpy, s_src, args)
  357. SCM s_dpy, s_src, args;
  358. {
  359.   Drawable src, dst;
  360.   GC gc;
  361.   SCM s;
  362.   int src_x, src_y, width, height, dst_x, dst_y;
  363.  
  364.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_copy_area);
  365.   ASSERT(NIMP(s_src) && XDRAWABLEP(s_src), s_src, ARG2, s_x_copy_area);
  366.   src = XWINDOWP(s_src) ? XWINDOW(s_src) : XPIXMAP(s_src);
  367.  
  368.   ASSERT(NIMP(args) && CONSP(args), args, ARG3, s_x_copy_area);
  369.   s = CAR(args); args = CDR(args);
  370.   ASSERT(NIMP(s) && XDRAWABLEP(s), s, ARG3, s_x_copy_area);
  371.   dst = XWINDOWP(s) ? XWINDOW(s) : XPIXMAP(s);
  372.  
  373.   ASSERT(NIMP(args) && CONSP(args), args, ARG4, s_x_copy_area);
  374.   s = CAR(args); args = CDR(args);
  375.   ASSERT(NIMP(s) && XGCP(s), s, ARG4, s_x_copy_area);
  376.   gc = XGC(s);
  377.  
  378.   GET_NEXT_INT(src_x, args, ARG5, s_x_copy_area);
  379.   GET_NEXT_INT(src_y, args, ARG6, s_x_copy_area);
  380.   GET_NEXT_INT(width, args, ARG7, s_x_copy_area);
  381.   GET_NEXT_INT(height, args, ARG8, s_x_copy_area);
  382.   GET_NEXT_INT(dst_x, args, ARG9, s_x_copy_area);
  383.   GET_NEXT_INT(dst_y, args, "arg10", s_x_copy_area);
  384.  
  385.   XCopyArea(XDISPLAY(s_dpy), src, dst, gc, src_x, src_y, width, height, dst_x, dst_y);
  386.  
  387.   return UNSPECIFIED;
  388. }
  389.  
  390.  
  391. SCM x_create_colormap(s_dpy, s_win, salloc)
  392. SCM s_dpy, s_win, salloc;
  393. {
  394.   int alloc;
  395.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_create_colormap);
  396.   ASSERT(NIMP(s_win) && XWINDOWP(s_win), s_win, ARG2, s_x_create_colormap);
  397.   ASSERT(INUMP(salloc), salloc, ARG3, s_x_create_colormap);
  398.   alloc = INUM(salloc);
  399.   ASSERT(alloc == AllocNone || alloc == AllocAll, salloc, "invalid alloc parameter",
  400.          s_x_create_colormap);
  401.   return make_xcolormap(XCreateColormap(
  402.     XDISPLAY(s_dpy),
  403.     XWINDOW(s_win),
  404.     DefaultVisual(XDISPLAY(s_dpy), 0),
  405.     alloc));
  406. }
  407.  
  408.  
  409. SCM x_create_gc(s_dpy, s_drwbl, args)
  410. SCM s_dpy, s_drwbl, args;
  411. {
  412.   SCM sgc;
  413.   Drawable drawable;
  414.   XGCValues v;
  415.   int mask;
  416.  
  417.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_create_gc);
  418.   ASSERT(s_drwbl == EOL || (NIMP(s_drwbl) && XDRAWABLEP(s_drwbl)), s_drwbl, ARG2, s_x_create_gc);
  419.   if (s_drwbl == EOL)
  420.     drawable = DefaultRootWindow(XDISPLAY(s_dpy));
  421.   else
  422.     drawable = (Drawable) CDR(s_drwbl);
  423.   x__make_gc_values(&v, &mask, args);
  424.   sgc = make_xgc(XCreateGC(XDISPLAY(s_dpy), drawable, mask, &v));
  425.   return sgc;
  426. }
  427.  
  428. static void x__make_gc_values(valuep, maskp, args)
  429. XGCValues *valuep;
  430. int *maskp;
  431. SCM args;
  432. {
  433.   SCM sbit;
  434.   int bit;
  435.   SCM svalue;
  436.   int l;
  437.  
  438.   *maskp = 0;
  439.   (void) memset((char *) valuep, 0, sizeof(XGCValues));
  440.   l = ilength(args);
  441.   if (l == 0) return;
  442.   ASSERT(l > 0 && (! (l & 1)), args, WNA, s_x__make_gc_values);
  443.   while (l) {
  444.     ASSERT(NIMP(args) && CONSP(args), args, ARG1, s_x__make_gc_values);
  445.     sbit = CAR(args);
  446.     args = CDR(args);
  447.     ASSERT(NIMP(args) && CONSP(args), args, ARG1, s_x__make_gc_values);
  448.     svalue = CAR(args);
  449.     args = CDR(args);
  450.     bit = INUM(sbit);
  451.     *maskp |= bit;
  452.     switch (bit) {
  453.       case GCFunction:        valuep->function = INUM(svalue);    break;
  454.       case GCPlaneMask:        valuep->plane_mask = INUM(svalue);    break;
  455.       case GCForeground:    valuep->foreground = INUM(svalue);    break;
  456.       case GCBackground:    valuep->background = INUM(svalue);    break;
  457.       case GCLineWidth:        valuep->line_width = INUM(svalue);    break;
  458.       default:
  459.     ASSERT(0, sbit, ARG1, s_x__make_gc_values);
  460.     }
  461.     l -= 2;
  462.   }
  463. }
  464.  
  465. SCM x_create_pixmap(s_dpy, s_drwbl, args)
  466. SCM s_dpy, s_drwbl, args;
  467. {
  468.   unsigned int width, height, depth;
  469.   Drawable drawable;
  470.   Pixmap p;
  471.   SCM sp;
  472.  
  473.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_create_pixmap);
  474.   ASSERT(s_drwbl == EOL || (NIMP(s_drwbl) && XDRAWABLEP(s_drwbl)), s_drwbl, ARG2, s_x_create_pixmap);
  475.   if (s_drwbl == EOL)
  476.     drawable = DefaultRootWindow(XDISPLAY(s_dpy));
  477.   else
  478.     drawable = (Drawable) CDR(s_drwbl);
  479.   GET_NEXT_INT(width, args, ARG3, s_x_create_pixmap);
  480.   GET_NEXT_INT(height, args, ARG4, s_x_create_pixmap);
  481.   GET_NEXT_INT(depth, args, ARG5, s_x_create_pixmap);
  482.  
  483.   p = XCreatePixmap(XDISPLAY(s_dpy), drawable, width, height, depth);
  484.   sp = make_xpixmap();
  485.   SETCDR(sp, p);
  486.  
  487.   return sp;
  488. }
  489.  
  490.  
  491. SCM x_default_colormap(s_dpy, s_screen)
  492. SCM s_dpy, s_screen;
  493. {
  494.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_default_colormap);
  495.   ASSERT(INUMP(s_screen), s_screen, ARG1, s_x_default_colormap);
  496.   return make_xcolormap(DefaultColormap(XDISPLAY(s_dpy), INUM(s_screen)));
  497. }
  498.  
  499.  
  500. SCM x_define_cursor(s_dpy, s_win, scursor)
  501. SCM s_dpy, s_win, scursor;
  502. {
  503.   int i;
  504.   Cursor cursor;
  505.  
  506.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_define_cursor);
  507.   ASSERT(NIMP(s_win) && XWINDOWP(s_win), s_win, ARG2, s_x_define_cursor);
  508.   ASSERT(NIMP(scursor) && SYMBOLP(scursor), scursor, ARG3, s_x_define_cursor);
  509.   for (i = 0; i < sizeof(cursor_table) / sizeof(cursor_table[0]); i++) {
  510.     if (scursor == cursor_table[i].sym) {
  511.       cursor = XCreateFontCursor(XDISPLAY(s_dpy), cursor_table[i].id);
  512.       XDefineCursor(XDISPLAY(s_dpy), XWINDOW(s_win), cursor);
  513.       return UNSPECIFIED;
  514.     }
  515.   }
  516.   return UNSPECIFIED;
  517. }
  518.  
  519.  
  520. SCM x_undefine_cursor(s_dpy, s_win)
  521. SCM s_dpy, s_win;
  522. {
  523.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_undefine_cursor);
  524.   ASSERT(NIMP(s_win) && XWINDOWP(s_win), s_win, ARG2, s_x_undefine_cursor);
  525.  
  526.   XUndefineCursor(XDISPLAY(s_dpy), XWINDOW(s_win));
  527.   return UNSPECIFIED;
  528. }
  529.  
  530.  
  531. SCM x_free_colormap(s_dpy, s_cmap)
  532. SCM s_dpy, s_cmap;
  533. {
  534.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_free_colormap);
  535.   ASSERT(NIMP(s_cmap) && XCOLORMAPP(s_cmap), s_cmap, ARG2, s_x_free_colormap);
  536.  
  537.   XFreeColormap(XDISPLAY(s_dpy), XPIXMAP(s_cmap));
  538.  
  539.   return UNSPECIFIED;
  540. }
  541.  
  542.  
  543. SCM x_free_pixmap(s_dpy, spixmap)
  544. SCM s_dpy, spixmap;
  545. {
  546.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_free_pixmap);
  547.   ASSERT(NIMP(spixmap) && XPIXMAPP(spixmap), spixmap, ARG2, s_x_free_pixmap);
  548.  
  549.   XFreePixmap(XDISPLAY(s_dpy), XPIXMAP(spixmap));
  550.  
  551.   return UNSPECIFIED;
  552. }
  553.  
  554.  
  555. SCM x_install_colormap(s_dpy, s_cmap)
  556. SCM s_dpy, s_cmap;
  557. {
  558.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_install_colormap);
  559.   ASSERT(NIMP(s_cmap) && XCOLORMAPP(s_cmap), s_cmap, ARG2, s_x_install_colormap);
  560.   XInstallColormap(XDISPLAY(s_dpy), XCOLORMAP(s_cmap));
  561.   return UNSPECIFIED;
  562. }
  563.  
  564.  
  565. SCM x_set_background(s_dpy, sgc, scolor)
  566. SCM s_dpy, sgc, scolor;
  567. {
  568.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_set_background);
  569.   ASSERT(NIMP(sgc) && XGCP(sgc), sgc, ARG2, s_x_set_background);
  570.   ASSERT(INUMP(scolor), scolor, ARG3, s_x_set_background);
  571.  
  572.   XSetBackground(XDISPLAY(s_dpy), (GC) CDR(sgc), INUM(scolor));
  573.  
  574.   return UNSPECIFIED;
  575. }
  576.  
  577. SCM x_set_foreground(s_dpy, sgc, scolor)
  578. SCM s_dpy, sgc, scolor;
  579. {
  580.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_set_foreground);
  581.   ASSERT(NIMP(sgc) && XGCP(sgc), sgc, ARG2, s_x_set_foreground);
  582.   ASSERT(INUMP(scolor), scolor, ARG3, s_x_set_foreground);
  583.  
  584.   XSetForeground(XDISPLAY(s_dpy), (GC) CDR(sgc), INUM(scolor));
  585.  
  586.   return UNSPECIFIED;
  587. }
  588.  
  589. SCM x_display_cells(sd, si)
  590. SCM sd, si;
  591. {
  592.   ASSERT(NIMP(sd) && XDISPLAYP(sd), sd, ARG1, s_x_display_cells);
  593.   ASSERT(INUMP(si), si, ARG2, s_x_display_cells);
  594.  
  595.   return MAKINUM(DisplayCells(XDISPLAY(sd), INUM(si)));
  596. }
  597.  
  598. SCM x_display_depth(sd,si)
  599. SCM sd, si;
  600. {
  601.   ASSERT(NIMP(sd) && XDISPLAYP(sd), sd, ARG1, s_x_display_depth);
  602.   ASSERT(INUMP(si), si, ARG2, s_x_display_depth);
  603.  
  604.   return MAKINUM(DisplayPlanes(XDISPLAY(sd), INUM(si)));
  605. }
  606.  
  607. SCM x_display_height(sd,si)
  608. SCM sd, si;
  609. {
  610.   ASSERT(NIMP(sd) && XDISPLAYP(sd), sd, ARG1, s_x_display_height);
  611.   ASSERT(INUMP(si), si, ARG2, s_x_display_height);
  612.  
  613.   return MAKINUM(DisplayHeight(XDISPLAY(sd), INUM(si)));
  614. }
  615.  
  616. SCM x_display_width(sd,si)
  617. SCM sd, si;
  618. {
  619.   ASSERT(NIMP(sd) && XDISPLAYP(sd), sd, ARG1, s_x_display_width);
  620.   ASSERT(INUMP(si), si, ARG2, s_x_display_width);
  621.  
  622.   return MAKINUM(DisplayWidth(XDISPLAY(sd), INUM(si)));
  623. }
  624.  
  625. SCM x_draw_lines(s_dpy, s_drwbl, args)
  626. SCM s_dpy, s_drwbl, args;
  627. {
  628.   x__draw(s_dpy, s_drwbl, args, XDrawLines, s_x_draw_lines);
  629.   return UNSPECIFIED;
  630. }
  631.  
  632. SCM x_draw_points(s_dpy, s_drwbl, args)
  633. SCM s_dpy, s_drwbl, args;
  634. {
  635.   x__draw(s_dpy, s_drwbl, args, XDrawPoints, s_x_draw_points);
  636.   return UNSPECIFIED;
  637. }
  638.  
  639. static void x__draw(s_dpy, s_drwbl, args, rtn, name)
  640. SCM s_dpy, s_drwbl, args;
  641. void (*rtn)();
  642. char *name;
  643. {
  644.   Display *display;
  645.   Drawable drawable;
  646.   SCM sgc, spoint, item;
  647.   GC gc;
  648.   int x, y, mode, len, i;
  649.   XPoint *p;
  650.  
  651.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, name);
  652.   ASSERT(NIMP(s_drwbl) && XDRAWABLEP(s_drwbl), s_drwbl, ARG2, name);
  653.   display = XDISPLAY(s_dpy);
  654.   drawable = XWINDOWP(s_drwbl) ? XWINDOW(s_drwbl) : XPIXMAP(s_drwbl);
  655.  
  656.   ASSERT(NIMP(args) && CONSP(args), args, ARG3, name);
  657.   sgc = CAR(args);
  658.   args = CDR(args);
  659.   ASSERT(NIMP(sgc) && XGCP(sgc), sgc, ARG3, name);
  660.   gc = XGC(sgc);
  661.  
  662.   GET_NEXT_INT(mode, args, ARG4, name);
  663.  
  664.   len = ilength(args);
  665.   ASSERT(len > 0, args, WNA, name);
  666.   p = (XPoint *) must_malloc(len * sizeof(XPoint));
  667.  
  668.   for (i = 0; i < len; i++) {
  669.     ASSERT(NIMP(args) && CONSP(args), args, "bad point list", name);
  670.     item = CAR(args);
  671.     args = CDR(args);
  672.     ASSERT(NIMP(item) && CONSP(item) && INUMP(CAR(item)) && INUMP(CDR(item)),
  673.       item, "bad point list", name);
  674.     p[i].x = INUM(CAR(item));
  675.     p[i].y = INUM(CDR(item));
  676.   }
  677.  
  678.   rtn(display, drawable, gc, p, len, mode);
  679.   free(p);
  680. }
  681.  
  682. SCM x_fill_rectangle(s_dpy, s_drwbl, args)
  683. SCM s_dpy, s_drwbl, args;
  684. {
  685.   Drawable drawable;
  686.   SCM sgc;
  687.   GC gc;
  688.   int x, y, width, height;
  689.  
  690.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_fill_rectangle);
  691.   ASSERT(NIMP(s_drwbl) && XDRAWABLEP(s_drwbl), s_drwbl, ARG2, s_x_fill_rectangle);
  692.   drawable = (Drawable) CDR(s_drwbl);
  693.  
  694.   ASSERT(NIMP(args) && CONSP(args), args, ARG3, s_x_fill_rectangle);
  695.   sgc = CAR(args);
  696.   args = CDR(args);
  697.   ASSERT(NIMP(sgc) && XGCP(sgc), sgc, ARG3, s_x_fill_rectangle);
  698.   gc = (GC) CDR(sgc);
  699.  
  700.   GET_NEXT_INT(x, args, ARG4, s_x_fill_rectangle);
  701.   GET_NEXT_INT(y, args, ARG5, s_x_fill_rectangle);
  702.   GET_NEXT_INT(width, args, "arg6", s_x_fill_rectangle);
  703.   GET_NEXT_INT(height, args, "arg7", s_x_fill_rectangle);
  704.  
  705.   XFillRectangle(XDISPLAY(s_dpy), drawable, gc, x, y, width, height);
  706.  
  707.   return UNSPECIFIED;
  708. }
  709.  
  710. /* This function _is_ used, in xevent.h */
  711.  
  712. SCM x_make_bool(f)
  713. Bool f;
  714. {
  715.   return f ? BOOL_F : BOOL_T;
  716. }
  717.  
  718.  
  719. SCM x_flush(sd)
  720. SCM sd;
  721. {
  722.   ASSERT(NIMP(sd) && XDISPLAYP(sd), sd, ARG1, s_x_flush);
  723.   XFlush(XDISPLAY(sd));
  724.   return UNSPECIFIED;
  725. }
  726.  
  727.  
  728. SCM x_get_event_field(sevent, sfield)
  729. SCM sevent, sfield;
  730. {
  731.   void *x;
  732.  
  733.   ASSERT(NIMP(sevent) && XEVENTP(sevent), sevent, ARG1, s_x_get_event_field);
  734.   ASSERT(INUMP(sfield), sfield, ARG2, s_x_get_event_field);
  735.  
  736.   x = (void *) CHARS(sevent);
  737.   switch (INUM(sfield)) {
  738. #include "xevent.h"
  739.     default:
  740.       return BOOL_F;
  741.   }
  742. }
  743.  
  744.  
  745. SCM x_root_window(sdpy, sscr)
  746. SCM sdpy, sscr;
  747. {
  748.   ASSERT(NIMP(sdpy) && XDISPLAYP(sdpy), sdpy, ARG1, s_x_root_window);
  749.   ASSERT(INUMP(sscr), sscr, ARG2, s_x_root_window);
  750.   return make_xwindow(RootWindow(XDISPLAY(sdpy), INUM(sscr)));
  751. }
  752.  
  753.  
  754. SCM x_set_window_colormap(s_dpy, s_win, s_cmap)
  755. SCM s_dpy, s_win, s_cmap;
  756. {
  757.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_set_window_colormap);
  758.   ASSERT(NIMP(s_win) && XWINDOWP(s_win), s_win, ARG2, s_x_set_window_colormap);
  759.   ASSERT(NIMP(s_cmap) && XCOLORMAPP(s_cmap), s_cmap, ARG3, s_x_set_window_colormap);
  760.   XSetWindowColormap(XDISPLAY(s_dpy), XWINDOW(s_win), XCOLORMAP(s_cmap));
  761.   return UNSPECIFIED;
  762. }
  763.  
  764.  
  765. SCM x_store_color(s_dpy, s_cmap, s_args)
  766. SCM s_dpy, s_cmap, s_args;
  767. {
  768.   XColor color;
  769.  
  770.   ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_store_color);
  771.   ASSERT(NIMP(s_cmap) && XCOLORMAPP(s_cmap), s_cmap, ARG2, s_x_store_color);
  772.   GET_NEXT_INT(color.pixel, s_args, ARG3, s_x_store_color);
  773.   GET_NEXT_INT(color.red, s_args, ARG4, s_x_store_color);
  774.   GET_NEXT_INT(color.green, s_args, ARG5, s_x_store_color);
  775.   GET_NEXT_INT(color.blue, s_args, ARG6, s_x_store_color);
  776.   color.flags = DoRed | DoGreen | DoBlue;
  777.   XStoreColor(XDISPLAY(s_dpy), XCOLORMAP(s_cmap), &color);
  778.   return UNSPECIFIED;
  779. }
  780.  
  781. static struct {
  782.   int type;
  783.   char *name;
  784. } event_names[] = {
  785.   {KeyPress,        "KeyPress"},
  786.   {KeyRelease,        "KeyRelease"},
  787.   {ButtonPress,        "ButtonPress"},
  788.   {ButtonRelease,    "ButtonRelease"},
  789.   {MotionNotify,    "MotionNotify"},
  790.   {EnterNotify,        "EnterNotify"},
  791.   {LeaveNotify,        "LeaveNotify"},
  792.   {FocusIn,        "FocusIn"},
  793.   {FocusOut,        "FocusOut"},
  794.   {KeymapNotify,    "KeymapNotify"},
  795.   {Expose,        "Expose"},
  796.   {GraphicsExpose,    "GraphicsExpose"},
  797.   {NoExpose,        "NoExpose"},
  798.   {VisibilityNotify,    "VisibilityNotify"},
  799.   {CreateNotify,    "CreateNotify"},
  800.   {DestroyNotify,    "DestroyNotify"},
  801.   {UnmapNotify,        "UnmapNotify"},
  802.   {MapNotify,        "MapNotify"},
  803.   {MapRequest,        "MapRequest"},
  804.   {ReparentNotify,    "ReparentNotify"},
  805.   {ConfigureNotify,    "ConfigureNotify"},
  806.   {ConfigureRequest,    "ConfigureRequest"},
  807.   {GravityNotify,    "GravityNotify"},
  808.   {ResizeRequest,    "ResizeRequest"},
  809.   {CirculateNotify,    "CirculateNotify"},
  810.   {CirculateRequest,    "CirculateRequest"},
  811.   {PropertyNotify,    "PropertyNotify"},
  812.   {SelectionClear,    "SelectionClear"},
  813.   {SelectionRequest,    "SelectionRequest"},
  814.   {SelectionNotify,    "SelectionNotify"},
  815.   {ColormapNotify,    "ColormapNotify"},
  816.   {ClientMessage,    "ClientMessage"},
  817.   {MappingNotify,    "MappingNotify"},
  818. };
  819.  
  820. static char *x__event_name(type)
  821. int type;
  822. {
  823.   int i;
  824.  
  825.   for (i = 0; i < sizeof(event_names) / sizeof(event_names[0]); i++) {
  826.     if (type == event_names[i].type)
  827.       return event_names[i].name;
  828.   }
  829.   return "unknown";
  830. }
  831.  
  832. static int print_xcolormap(exp, f, writing)
  833. SCM exp;
  834. FILE *f;
  835. int writing;
  836. {
  837.   lputs("#<X colormap>", f);
  838.   return 1;
  839. }
  840.  
  841. static int print_xevent(exp, f, writing)
  842. SCM exp;
  843. FILE *f;
  844. int writing;
  845. {
  846.   lputs("#<X event: ", f);
  847.   lputs(x__event_name(XEVENT(exp)->type), f);
  848.   lputc('>', f);
  849.   return 1;
  850. }
  851.  
  852. static int print_xdisplay(exp, f, writing)
  853. SCM exp;
  854. FILE *f;
  855. int writing;
  856. {
  857.   lputs("#<X display \"", f);
  858.   lputs(XDISPLAY(exp)->display_name, f);
  859.   lputs("\">", f);
  860.   return 1;
  861. }
  862.  
  863. static int print_xgc(exp, f, writing)
  864. SCM exp;
  865. FILE *f;
  866. int writing;
  867. {
  868.   lputs("#<X graphics context, ID #x", f);
  869.   intprint((long) XGC(exp)->gid, 16, f);
  870.   lputc('>', f);
  871.   return 1;
  872. }
  873.  
  874. static int print_xpixmap(exp, f, writing)
  875. SCM exp;
  876. FILE *f;
  877. int writing;
  878. {
  879.   lputs("#<X pixmap #x", f);
  880.   intprint((long) XPIXMAP(exp), 16, f);
  881.   lputc('>', f);
  882.   return 1;
  883. }
  884.  
  885. static int print_xwindow(exp, f, writing)
  886. SCM exp;
  887. FILE *f;
  888. int writing;
  889. {
  890.   lputs("#<X window #x", f);
  891.   intprint((long) XWINDOW(exp), 16, f);
  892.   lputc('>', f);
  893.   return 1;
  894. }
  895.  
  896.  
  897. static void init_x_cursors()
  898. {
  899.   int i;
  900.   SCM s;
  901.  
  902.   for (i = 0; i < sizeof(cursor_table)/sizeof(cursor_table[0]); i++) {
  903.     s = sysintern(cursor_table[i].name, UNDEFINED);
  904.     cursor_table[i].sym = CAR(s);
  905.     CDR(s) = CAR(s);
  906.   }
  907. }
  908.  
  909.  
  910. #include "version.h"
  911.  
  912. SCM x_x_scm_version()
  913. {
  914.   return makfromstr(X_SCM_VERSION, sizeof(X_SCM_VERSION) - 1);
  915. }
  916.  
  917.  
  918. iproc x_lsubr2s[] = {
  919.   {s_x_alloc_color,        x_alloc_color},
  920.   {s_x_alloc_color_cells,    x_alloc_color_cells},
  921.   {s_x_clear_area,        x_clear_area},
  922.   {s_x_copy_area,        x_copy_area},
  923.   {s_x_create_gc,        x_create_gc},
  924.   {s_x_create_pixmap,        x_create_pixmap},
  925.   {s_x_draw_lines,        x_draw_lines},
  926.   {s_x_draw_points,        x_draw_points},
  927.   {s_x_fill_rectangle,        x_fill_rectangle},
  928.   {s_x_store_color,        x_store_color},
  929.   {0, 0}
  930. };
  931.  
  932. iproc x_subr3s[] = {
  933.   {s_x_create_colormap,        x_create_colormap},
  934.   {s_x_define_cursor,        x_define_cursor},
  935.   {s_x_set_background,        x_set_background},
  936.   {s_x_set_foreground,        x_set_foreground},
  937.   {s_x_set_window_colormap,    x_set_window_colormap},
  938.   {0, 0}
  939. };
  940.  
  941. iproc x_subr2s[] = {
  942.   {s_x_default_colormap,    x_default_colormap},
  943.   {s_x_display_cells,        x_display_cells},
  944.   {s_x_display_depth,        x_display_depth},
  945.   {s_x_display_height,        x_display_height},
  946.   {s_x_display_width,        x_display_width},
  947.   {s_x_free_pixmap,        x_free_pixmap},
  948.   {s_x_get_event_field,        x_get_event_field},
  949.   {s_x_install_colormap,    x_install_colormap},
  950.   {s_x_root_window,        x_root_window},
  951.   {s_x_undefine_cursor,        x_undefine_cursor},
  952.   {0, 0}
  953. };
  954.  
  955. iproc x_subr1s[] = {
  956.   {s_x_flush,            x_flush},
  957.   {0, 0}
  958. };
  959.  
  960. iproc x_subr0s[] = {
  961.   {s_x_x_scm_version,        x_x_scm_version},
  962.   {0, 0}
  963. };
  964.  
  965. #undef XX
  966. #define XX(name, mark, free) TOKEN_PASTE(tc16_,name) = newsmob(&TOKEN_PASTE(smob,name));
  967.  
  968. void init_x()
  969. {
  970.   init_iprocs(x_lsubr2s, tc7_lsubr_2);
  971.   init_iprocs(x_subr3s, tc7_subr_3);
  972.   init_iprocs(x_subr2s, tc7_subr_2);
  973.   init_iprocs(x_subr1s, tc7_subr_1);
  974.   init_iprocs(x_subr0s, tc7_subr_0);
  975.   X_SMOBS
  976.   init_x_cursors();
  977. }
  978.